00100	C ********** EARLY MUSIC NOTATION PACKAGE ************
00200	C TO CHANGE CONVENTIONAL NOTATION ENTERED WITH '14' OR '144' TO EARLY MUSIC
00300	C NOTATION, ADD 500 TO P4 OF ALL NOTES AND RESTS. (USE 'A' COMMAND.)
00400	C THE VARIOUS NOTE SHAPES ARE DETERMINED BY THE RHYTHMIC VALUE FOUND IN P9
00500	C (OR P7 WITH RESTS).  THE SAME SHAPES CAN BE MADE BY PUTTING VALUES IN P6 IF
00600	C P9=0.  THE FOLLOWING TABLE SHOWS NUMBERS FOR BOTH METHODS.  THE RHYTHMIC
00700	C VALUE (P9 OR P7) COMES BEFORE THE SHAPE NAME.  THE P6 VALUES FOLLOW EACH NAME.
00800	C THE STANDARD NOTE VALUES WOULD BE: DOUBLE WHOLE, WHOLE, 1/2, 1/4, 1/8, 1/16.
00900	C  8 = MAXIMA = 20;      4 = LONGA = 21;   2 = BREVIS = 22;
01000	C  1 = SEMIBREVE = 23;  .5 = MINIM = 24;  .25 = SEMIMINIM = 25;
01100	
01200	C  SET 'COLORATION' IN P8 IF NOT SET BY RHYTH.(P9)  -1=BLACK, 0=WHITE HERE.
01300	
01400	C MENSURATION SIGNS ARE CONSIDERED TO BE A FORM OF 'NOTE'.  THE VERTICAL
01500	C POSITION IS SET IN P4 WITH THE 'ZERO' LEVEL BEING IN THE SECOND SPACE FROM
01600	C THE BOTTOM OF THE STAFF. (POSITION OF NOTE 'A'.)
01700	C SET P9 TO 0 AND P6 AS FOLLOWS.
01800	C MENSURATION SIGNS: P6 =30=C; 31=C WITH DOT IN MIDDLE; 32=C WITH SLASH; 
01900	C  			33=O; 34=O WITH SLASH.
02000	
02100	C  LIGATURES ARE CREATED FROM COMBINATIONS OF MAXIMA, LONGA AND BREVIS SHAPES
02200	C  OR, FOR THE SLOPED SHAPES, BY SETTING P9=0 AND P6 EQUAL TO SOME NUMBER FROM
02300	C  11 TO 19.  FOR SLOPES IT IS THE SECOND DIGIT OF THE NUMBER THAT DETERMINES
02400	C  THE GOAL OF THE SLOPE.  IF THE NUMBER IS NEGATIVE THE SLOPE WILL BE DOWNWARD.
02500	C    P4=504  P6=11 WILL MAKE A SLOPE FROM F (TREBLE CLEF) UP TO G.
02600	C    IF P6=14 THE SLOPE WILL BE FROM F UP TO C.  P4=508  P6=-14 WILL GIVE A
02700	C    SLOPE DOWN FROM C TO F.
02800	
02900	C TO MOVE ANY SLOPING LIGATURE EXACTLY ITS OWN WIDTH TO THE LEFT (FOR COMB-
03000	C INED LIGATURES) SET P9 TO -1.  P3 WILL THEN INDICATED THE POSITION OF ITS
03100	C RIGHT SIDE INSTEAD OF ITS LEFT SIDE.
03200	
03300	C  FOR THE COMBINATION LIGATURES, FIRST SET P9 TO 0. NEXT THE RIGHT HAND
03400	C SQUARE WILL BE SET.  P6=22 GIVES A SIMPLE SQUARE WITH NO STEM.(BREVIS)
03500	C FOR A DESCENDING STEM ON THE RIGHT SIDE, P6=21.(LONGA)
03600	C FOR AN ASCENDING STEM ON THE RIGHT SIDE, P6=29.
03700	C FOR A STEM ON THE LEFT SIDE OF THE SQUARE SET P7 TO A NEGATIVE NUMBER.
03800	C THE ABSOLUTE VALUE OF THIS NUMBER WILL DETERMINE THE LENGTH OF THE STEM.
03900	C THE DIRECTION OF THIS LEFT STEM IS SET IN P5. UP, P5=10; DOWN, P5=20.
04000	
04100	C THE LEFT HAND SQUARE IS IS BEST ENTERED BY MAKING A COPY OF THE RIGHT ONE.
04200	C WITH THE COPY, WHEN P5 IS SET TO -1 THE SQUARE PIVOTS ON ITS LEFT SIDE.
04300	C THIS NEW NOTE MAY BE MOVED UP OR DOWN TO THE PROPER POSITION.  AS A
04400	C RESULT OF THIS PIVOTING A STEM THAT WAS ORIGINALLY ON THE RIGHT SIDE NOW
04500	C APPEARS ON THE LEFT SIDE.(STEM UP, P6=21; DOWN, P6=29)  NO STEM CAN BE
04600	C PUT ON THE RIGHT SIDE OF A REVERSED NOTE.  ANY STEM NEEDED IN THE CENTRAL
04700	C POSITION, BETWEEN THE TWO SQUARES, CAN BE ADDED TO THE RIGHT HAND NOTE BY
04800	C PUTTING THE PROPER VALUES IN P7 (NEGATIVE) AND P5 (10=↑, 20=↓).  BY
04900	C CHANGING THE VALUES OF P7 THIS CENTRAL STEM MAY BE USED TO CONNECT THE
05000	C TWO NOTES TOGETHER AS WELL AS TO EXTEND BEYOND THE LEFT HAND NOTE.
05100	C BY USING THIS PIVOTING METHOD BOTH HALVES OF A TWO NOTE LIGATURE WILL
05200	C WILL HAVE THE SAME HORIZANTAL POSITION IN P3, WHICH WILL INDICATE THE
05300	C CENTER OF THE LIGATURE.
     

00100		SUBROUTINE EXTRA 
00200		IMPLICIT INTEGER(A-Q,S-Z)
00300		REAL POS
00400		COMMON /STF/RSTFAC(-3/4),RSTJ2
00500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00600		COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
00700		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RB,RZ,RJY,
00800		1 QQ,RJW,ZZ,JX,RG,KL,RJAC,K,L,RQ,RXO,J5X,RNO,JJJ,
00900		1 PUNCT,RDIS,RJ,ALF73
01000		EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(NJR,RJQ(8)),
01100		1 (J6,JQ(4)),(R8,RJQ(6)),(R7,RJQ(5)),(R9,RJQ(7)),(J9,JQ(7))
01200		1,(J4,JQ(2)),(R3,RJQ(1)),(J10,JQ(8)),(R11,RJQ(9)),(J8,JQ(6))
01300		1,(J7,JQ(5)),(RX3,RJQ(20)),(R5,RJQ(3)),(RH,RJQ(19)),(RXX,RJQ(18))
01400		1,(J3,JQ(1)),(NOLEDG,JQ(9))
01500		DATA RBIG/1.5/,RLIG/2.0/
01600	
01700		NOLEDG=J9
01800	C   P9=-1 SUPRESSES LEDGER LINE
01900		IF(JA.EQ.2)R9=R7
02000		KL=IABS(J6)
02100		IF(KL.GT.5)GO TO 10
02200		IF(R9.GT.0)GO TO 2
02300	10	IF(JA.EQ.1)J5=J6
02400		IF(KL.GE.30)GO TO 30
02500	C  JUMP FOR MENSURATION SIGNS.
02600	C  PUT NUM. IN P6 IF P9 NOT USED. 20=MAXIMA, 21=LONGA, 22=BREVIS, ETC.
02700		IF(R8.GE.0)R8=-2
02800	C  MAKES IT WHITE UNLESS -1 IS IN R8
02900		GO TO 3
03000	2	RH=.75
03100		DO 21 K=1,5
03200		IF(R9.NE.RH)GO TO 21
03300		R9=R9*2
03400		R9=R9/3.
03500		GO TO 22
03600	21	RH=RH*2.
03700	22	RA=AMOD(R9,.25)
03800	C  RA=0=WHITE,  ≠0='COLORATION'
03900		IF(RA.NE.0)R9=R9*1.5
04000	C  TO GET THE RIGHT SHAPE
04100		J5=19.5+ALOG(16./R9)/.693147181
04200	C  I.E. /ALOG(2.)  FINDS SEQ. NUM IN DRAW FILE 'EARLY'. 20=MAXIMA, ETC.
04300		R8=-1
04400	C  FILL IT ALWAYS (BLACK NOTE)
04500		IF(RA.EQ.0)R8=-2
04600	C  ALWAYS WHITE
04700	3	IF(JA.EQ.2)GO TO 20
04800		RH=R5
04900		JA=3 
05000		K=J4
05100		RXX=POS-18.*RSTJ2
05200		IF(J5.LT.20)GO TO 6
05300	C GO MAKE 'LIGATURES' P6=11=1 UP, =-11=1 DOWN, 12=2 UP, ETC.
05400		R6=RBIG
05500		NJR='CLEF2'
05600	C  ↑↑↑ EQUIV. TO R10
05700		R7=RBIG
05800		IF(R5)R6=-R6
05900	C  IF P5 IS NEG THEN ITEM MOVES TO LEFT EXACTLY ITS SPACE.
06000		J9=0
06025	       J8=R8
06050	       IF(J8.NE.-1)J8=-2
06100		IF(J5.NE.29)GO TO 17
06200		R7=-R7
06300		R4=R4-5.8
06400	C  MAKES LONGA WITH STEM UP -- FOR LIGATURES
06500		J5=21
06600		GO TO 7
06700	17	IF(J5.LT.23)GO TO 7
06800		IF(R8.EQ.-2)R8=0
06900	C  FOR DIFFERENT 'FILL' SITUATIONS
07050	7        CALL CLEFS
07100		IF(J5.LT.23)GO TO 18
07200		IF(R8.GE.0)GO TO 1
07300		IF(J5.EQ.29)GO TO 1
07400		J5=29
07500		R6=RBIG
07600		R7=RBIG
07700	C THIS PUTS 'MIDDLE' IN SEMIBREVE, MINIM AND SEMIMINIM
07800		GO TO 7
07900	
08000	18	IF(J7.GE.0)GO TO 1
08100	C IF P7 IS NEG THERE WILL BE A STEM ON LFT SIDE =ABS(R7), P5 HAS UP-DN.
08200		RG=R4
08300		R5=-J7*RST7
08400		GO TO 14
08500	6	RG=R4
08600	C THIS WILL BE FOR LIGATURE STEMS (P5=10=UP, =20=DOWN)
08700		IF(KL.GT.10)GO TO 11
08800		R6=-R6*10.
08900		GO TO 12
09000	11	R6=KL-10
09100		IF(J6)R6=-R6
09200	12	RX7=-.1
09300		IF(R6)RX7=-RX7
09400		R4=R4+RX7
09500		R6=R6-RX7*2.
09600	C  ABOVE TO ADJUST END POINTS OF TILTS.
09700		RX7=R7
09800		IF(J9)R3=R3-27.*RSTJ2
09900	C  J7=-1= SHIFT IT TO LEFT IT'S WIDTH.
10000		RA=R3
10100		IF(J8)GO TO 9
10200		RJW=POS
10300	5	R4=R4-.45
10400		J5=50
10500	C  P8<0=BLACK LIG.   ≥0=WHITE LIG.
10600		J10=0
10700	 	RXO=RLIG
10800		R8=3.9
10900		R11=R6
11000		R3=R3+13.85*RSTJ2
11100		RB=R3
11200		DO 55 JJJ=1,7 
11300		R9=RXO
11400		CALL ITMSUB
11500		POS=RJW
11600		R8=3.8
11700		R3=RB
11800	55	RXO=RXO-.144
11900	C  THICKENS HORIZ. SIDES
12000		R9=RXO
12100		GO TO 8
12200	9	R4=R4-.95
12300		J9=0
12400		R5=R4+R6/RSTJ2
12500	CC	R9=200
12600		J7=1
12700		R8=4.6
12800		R6=RX3+R8
12900		J10=14
13000	C  MAKES SLOPED DASH, 14XTHICK
13100		IF(J9.EQ.0)GO TO 8
13200		R6=RX3
13300		J3=R3
13400	8	CALL ITMSUB
13500		IF(RH.EQ.0)GO TO 13
13600		R5=ABS(RX7)
13700		IF(R5.EQ.0)R5=5
13800		R5=R5*RST7
13900	14	RG=RG*RST7+RXX
14000		IF(RH.GE.20)R5=-R5
14100	C NOW STEM IS DOWN. (-R5)
14200		CALL LINX(R3,RG,R3,RG+R5)
14300	13	R4=RG
14400		J5=20
14500		R3=RA
14600	
14700	1	IF(K.LT.502)GO TO 4
14800		IF(K.LT.513)RETURN
14900	C  WILL NOW DO 1 LEDG. LINE ABOVE OR BELOW.
15000	4	IF(NOLEDG)RETURN
15100		R4=RST7
15200		IF(K.GT.502)R4=13.*RST7
15300		R4=R4+RXX
15400		R5=20.
15500		IF(J5.EQ.20)R5=34.
15600		CALL LINX(R3-RST7,R4,R3+R5*RSTJ2,R4)
15700	
15800		RETURN
15900	
16000	20	IF(R9.NE.0)J5=R5+23.
16100		RG=POS
16200	C SAVE IT FOR SEMIMINIM REST HORIZANTAL
16300	C  RESTS ARE SET BY RHYTHM(R9,7) OR IN J5 (20-25)
16400		R5=(J5-20)*2+3
16500		RA=R4
16600		IF(R5.GT.8.)R5=8.
16700		R5=R4+R5
16800	C  RESTS (500+ IN P4) CAN BE MOVED UP OR DOWN
16900		R4=9
17000		IF(J5.GT.23)R4=7.
17100		R4=R4+RA
17200		J10=3
17300		J7=0
17400		R6=RX3
17500	C ALL THIS MAKES VERT. LINE.
17600		CALL ITMSUB
17700		IF(J5.LT.25)RETURN
17800	C NEXT IS FOR SEMIMINIM REST (1/16)
17900		R6=RX3+1.3
18000		R4=8+RA
18100		R5=R4
18200		POS=RG
18300		CALL ITMSUB
18400	 	RETURN
18500	
18600	C  MENSURATION SIGNS. USES P6 AS A NOTE. =30=C; 31=C.; 32=C/; 33=O; 34=O/
18700	30	R4=R4+6
18800		CALL CENTX
18900	C  P4=500 PUTS IT AT POS 6.
19000		R5=1
19100		J8=1
19200		IF(J5.GT.32)GO TO 31
19300	C  NEXT ARE C'S
19400		J6=125
19500		J7=45
19600		GO TO 32
19700	31	J6=0
19800		J7=0
19900	32	CALL CIRCLE
20000		IF(J5.NE.31)GO TO 33
20100	C  NEXT IS C.
20200		J5=0
20300		J6=0
20400		J7=0
20500		R5=.1
20600		GO TO 31
20700	33	IF(J5.LT.32)RETURN
20800		IF(J5.EQ.33)RETURN
20900		R5=R4+1
21000		R4=R4-1
21100		R3=R3-11.*RSTJ2
21200		J7=0
21300		R6=RX3+2*RSTJ2
21400		CALL ITMSUB
21500		END